home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / scrtst / scrntest.bas < prev    next >
BASIC Source File  |  1995-01-24  |  17KB  |  560 lines
  1. Option Explicit
  2. '
  3. ' User Defined Types
  4. '
  5.   '
  6.   ' Used for GetCursor - gets mouse location in screen coordinates.
  7.   '
  8.     Type POINTAPI
  9.       X As Integer
  10.       Y As Integer
  11.     End Type
  12.   '
  13.   ' Used by WM_SYSCOMMAND - converts mouse location.
  14.   '
  15.     Type ConvertPOINTAPI
  16.       xy As Long
  17.     End Type
  18.   '
  19.   ' .INI File Type - holds application .INI file information
  20.   '
  21.     Type INI_FILE_TYPE
  22.       fTop As Single
  23.       fLeft As Single
  24.       nStyle As Integer
  25.       lColor As Long
  26.       nGrab As Integer
  27.     End Type
  28.   '
  29.   ' Screen Size Type - holds screen size info
  30.   '
  31.     Type SCREEN_SIZE_TYPE
  32.       fVGA_HEIGHT As Single
  33.       fVGA_WIDTH As Single
  34.       fSVGA_HEIGHT As Single
  35.       fSVGA_WIDTH As Single
  36.       f1024_HEIGHT As Single
  37.       f1024_WIDTH As Single
  38.     End Type
  39.   '
  40.   ' Screen Rectangle type for API calls
  41.   '
  42.     Type lrect
  43.       Left As Integer
  44.       Top As Integer
  45.       Right As Integer
  46.       Bottom As Integer
  47.     End Type
  48. '
  49. ' API Calls
  50. '
  51.   '
  52.   ' Send Windows Message
  53.   '
  54.     Declare Function SendmessageByNum Lib "User" Alias "SendMessage" (ByVal hWnd As Integer, ByVal wMsg As Integer, ByVal wParam As Integer, ByVal lParam As Long) As Integer
  55.   '
  56.   ' Get Cursor Position
  57.   '
  58.     Declare Sub GetCursorPos Lib "User" (lpPoint As POINTAPI)
  59.   '
  60.   ' Set Window Position
  61.   '
  62.     Declare Function SetWindowPos Lib "User" (ByVal hWnd As Integer, ByVal hWndInsertAfter As Integer, ByVal X As Integer, ByVal Y As Integer, ByVal CX As Integer, ByVal CY As Integer, ByVal wFlags As Integer) As Integer
  63.   '
  64.   ' .INI File Functions
  65.   '
  66.     Declare Function GetPrivateProfileString Lib "Kernel" (ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Integer, ByVal lpFileName As String) As Integer
  67.     Declare Function WritePrivateProfileString Lib "Kernel" (ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal lpString As String, ByVal lplFileName As String) As Integer
  68.   '
  69.   ' Screen Capture Functions
  70.   '
  71.     Declare Function GetDesktopWindow Lib "User" () As Integer
  72.     Declare Function GetDC Lib "User" (ByVal hWnd As Integer) As Integer
  73.     Declare Function BitBlt Lib "GDI" (ByVal hDestDC As Integer, ByVal X As Integer, ByVal Y As Integer, ByVal nWidth As Integer, ByVal nHeight As Integer, ByVal hSrcDC As Integer, ByVal XSrc As Integer, ByVal YSrc As Integer, ByVal dwRop As Long) As Integer
  74.     Declare Function ReleaseDC Lib "User" (ByVal hWnd As Integer, ByVal hDC As Integer) As Integer
  75.     Declare Sub GetWindowRect Lib "User" (ByVal hWnd As Integer, lpRect As lrect)
  76.   '
  77.   ' System Menu API Declarations
  78.   '
  79.     Declare Function GetSystemMenu Lib "User" (ByVal hWnd As Integer, ByVal bRevert As Integer) As Integer
  80.     Declare Function RemoveMenu Lib "User" (ByVal hMenu As Integer, ByVal nPosition As Integer, ByVal wFlags As Integer) As Integer
  81. '
  82. ' Module Constants
  83. '
  84.   '
  85.   ' For SetWindowPos API Call
  86.   '
  87.     Const SWP_NOMOVE = 2
  88.     Const SWP_NOSIZE = 1
  89.     Const Flags = SWP_NOMOVE Or SWP_NOSIZE
  90.     Const HWND_TOPMOST = -1
  91.     Const HWND_NOTOPMOST = -2
  92.     Const HWND_BOTTOM = 1
  93.     Const HWND_TOP = 0
  94.   '
  95.   ' .INI file constants
  96.   '
  97.     Const INI_FILENAME = "SCRNTEST.INI"
  98.     Const MAX_INI_STRING = 255
  99.   '
  100.   ' System Menu Constants
  101.   '
  102.     Const MF_SEPARATOR = &H800
  103.     Const MF_STRING = &H0
  104.     Const MF_ENABLED = 0
  105.     Const MF_BYCOMMAND = &H0
  106.     Const MF_UNCHECKED = &H0
  107.     Const MF_CHECKED = &H8
  108.     Const MF_BYPOSITION = &H400
  109.   '
  110.   ' Move Window Message
  111.   '
  112.     Const SC_MOVE = &HF010
  113. '
  114. ' Global Constants
  115. '
  116.   '
  117.   ' For Window Movement API calls
  118.   '
  119.     Global Const WM_LBUTTONUP = &H202
  120.     Global Const WM_SYSCOMMAND = &H112
  121.     Global Const MOUSE_MOVE = &HF012
  122.   '
  123.   ' Standard VB Keyboard Constants
  124.   '
  125.     Global Const ALT_MASK = 4
  126.     Global Const KEY_F4 = &H73
  127.     Global Const KEY_LBUTTON = &H1
  128.     Global Const KEY_RBUTTON = &H2
  129.     Global Const KEY_HOME = &H24
  130.     Global Const KEY_LEFT = &H25
  131.     Global Const KEY_UP = &H26
  132.     Global Const KEY_RIGHT = &H27
  133.     Global Const KEY_DOWN = &H28
  134.   '
  135.   ' Standard VB WindowState Constant
  136.   '
  137.     Global Const NORMAL = 0
  138.     Global Const MINIMIZED = 1
  139.   '
  140.   ' Constants for PlaceDialog Subroutine
  141.   '
  142.     Global Const DLG_STANDARD = 0
  143.     Global Const DLG_CENTERED = 1
  144.   '
  145.   ' MsgBox Warning message Constant
  146.   '
  147.     Global Const MB_ICONEXCLAMATION = 48
  148.   '
  149.   ' Form Show Constants
  150.   '
  151.     Global Const MODELESS = 0
  152.     Global Const MODAL = 1
  153.   '
  154.   ' Style Constants (numbers should match menu control arrray on frmUtility)
  155.   '
  156.     Global Const STYLE_VGA = 0
  157.     Global Const STYLE_SVGA = 1
  158.     Global Const STYLE_1024 = 2
  159. '
  160. ' Module Variables
  161. '
  162.   '
  163.   ' Throwaway Return variable
  164.   '
  165.     Dim r As Variant
  166.   '
  167.   ' INI variable
  168.   '
  169.     Dim muINIVals As INI_FILE_TYPE
  170.   '
  171.   ' Screen pixel/size type
  172.   '
  173.     Dim muScreenVals As SCREEN_SIZE_TYPE
  174.  
  175. Sub ExitProgram ()
  176.   '
  177.   ' Centralized Exit from program that saves .INI values
  178.   ' and makes sure that all forms are unloaded prior to
  179.   ' ending
  180.   '
  181.   Dim iLoop As Integer
  182.   SaveINIValues
  183.   For iLoop = Forms.Count - 1 To 0 Step -1
  184.     Unload Forms(iLoop)
  185.   Next
  186.   End
  187. End Sub
  188.  
  189. Sub GetINIValues ()
  190.   '
  191.   ' Gets INI values from File
  192.   ' (all Topic|Section and Default values are hard coded)
  193.   '
  194.   Dim nSize As Integer
  195.   Dim sReturnString As String
  196.   '
  197.   ' Get Form Top Value
  198.   '
  199.   sReturnString = String$(MAX_INI_STRING, 32)
  200.   nSize = GetPrivateProfileString("Screen Tester", "Top", "300", sReturnString, MAX_INI_STRING, INI_FILENAME)
  201.   muINIVals.fTop = Val(Mid$(sReturnString, 1, nSize))
  202.   '
  203.   ' Get Form Left Value
  204.   '
  205.   sReturnString = String$(MAX_INI_STRING, 32)
  206.   nSize = GetPrivateProfileString("Screen Tester", "Left", "300", sReturnString, MAX_INI_STRING, INI_FILENAME)
  207.   muINIVals.fLeft = Val(Mid$(sReturnString, 1, nSize))
  208.   '
  209.   ' Get Form Style Value
  210.   '
  211.   sReturnString = String$(MAX_INI_STRING, 32)
  212.   nSize = GetPrivateProfileString("Screen Tester", "Style", "0", sReturnString, MAX_INI_STRING, INI_FILENAME)
  213.   muINIVals.nStyle = Val(Mid$(sReturnString, 1, nSize))
  214.   '
  215.   ' Get Form Color Value
  216.   '
  217.   sReturnString = String$(MAX_INI_STRING, 32)
  218.   nSize = GetPrivateProfileString("Screen Tester", "Color", "0", sReturnString, MAX_INI_STRING, INI_FILENAME)
  219.   muINIVals.lColor = Val(Mid$(sReturnString, 1, nSize))
  220.   '
  221.   ' Get Screen Grab Destination Preference
  222.   '
  223.   sReturnString = String$(MAX_INI_STRING, 32)
  224.   nSize = GetPrivateProfileString("Screen Tester", "Grab", "0", sReturnString, MAX_INI_STRING, INI_FILENAME)
  225.   muINIVals.nGrab = Val(Mid$(sReturnString, 1, nSize))
  226. End Sub
  227.  
  228. Function GetScreenHeight () As Integer
  229.   '
  230.   ' Return Pixel Screen Height based on current style value
  231.   '
  232.   Select Case muINIVals.nStyle
  233.     Case STYLE_VGA
  234.       GetScreenHeight = 480
  235.     Case STYLE_SVGA
  236.       GetScreenHeight = 600
  237.     Case STYLE_1024
  238.       GetScreenHeight = 768
  239.   End Select
  240. End Function
  241.  
  242. Function GetScreenWidth () As Integer
  243.   '
  244.   ' Return Pixel Screen Width based on current style value
  245.   '
  246.   Select Case muINIVals.nStyle
  247.     Case STYLE_VGA
  248.       GetScreenWidth = 640
  249.     Case STYLE_SVGA
  250.       GetScreenWidth = 800
  251.     Case STYLE_1024
  252.       GetScreenWidth = 1024
  253.   End Select
  254. End Function
  255.  
  256. Sub GrabScreen ()
  257.   '
  258.   ' Captures Screen area where floating screen is located
  259.   ' and sends it to the Clipboard or to BMP File
  260.   '
  261.   ' This routine is based on information found in the
  262.   ' following Knowledge Base article:
  263.   '
  264.   '   How to Copy Entire Screen into a Picture Box in Visual Basic
  265.   '   Article ID: Q80670
  266.   '
  267.   Dim winSize As lrect
  268.   Dim hWndSrc As Integer
  269.   Dim hSrcDC As Integer
  270.   Dim XSrc As Integer
  271.   Dim YSrc As Integer
  272.   Dim nWidth As Integer
  273.   Dim nHeight As Integer
  274.   Dim hDestDC As Integer
  275.   Dim X As Integer
  276.   Dim Y As Integer
  277.   Dim dwRop As Long
  278.   '
  279.   ' Constant for Clipboard operations
  280.   '
  281.   Const CF_BITMAP = 2
  282.   '
  283.   ' Assign information of the source bitmap.
  284.   ' Note that BitBlt requires coordinates in pixels.
  285.   '
  286.   hWndSrc = G